Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mtappl.i

Modula Implementation | 1997-10-26 | 18.2 KB | 637 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtAppl;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*
 *  3.01     | 02.02.92 |  Hp  | Proc. ApplName aufgenommen. Bei Appl-  *
 *           |          |      | path wird jetzt der Filename gel”scht  *
 *-----------+----------+------+----------------------------------------*
 *  3.02     | 10.02.92 |  Hp  | Variable DeskX und DeskY aufgenommen.  *
 *           |          |      | Sie enthalten den Ursprung des Desktop *
 *           |          |      | Damit sparen sich die Klientmodule den *
 *           |          |      | Aufruf von Windget um die Fenstergr”že *
 *           |          |      | zu ermitteln.                          *
 *-----------+----------+------+----------------------------------------*
 *  3.03     | 18.03.92 |  Hp  | Die Ermittlung der Bitplanes erfolgt   *
 *           |          |      | jetzt mittels vq_extnd. Der Grund ist, *
 *           |          |      | daž es neuerdings eine TrueColor-Karte *
 *           |          |      | gibt, bei der das AES Probleme bekommt *
 *           |          |      | Ich bin allerdings der Meinung, das es *
 *           |          |      | Aufgabe des Treibers w„re, diesen Wert *
 *           |          |      | korrekt an das AES zu bermitteln...   *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)








FROM Storage IMPORT ALLOCATE, DEALLOCATE;




FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;






FROM SYSTEM IMPORT  ADDRESS, ADR, BYTE, TSIZE;
FROM MagicStrings IMPORT  Append, Assign, Length, Equal, Insert;
IMPORT  MagicTypes, MagicAES, MagicVDI, MagicDOS, MagicBIOS, MagicSys;


(*----------------------------------------------------------------------*)

CONST   ABCGEM =        0210H;

CONST   cFonts =        0;
        cPhysical =     1;
       (* cOpen Wird nicht mehr ben”tigt, da der Pointer nun beim Schliessen
        * der Workstation gel”scht wird.
        *)

CONST   NDC =           0;
        RC =            2;

CONST   MaxMaus =       64; (* Verschachtelungstiefe von Store/RestoreMouse *)

TYPE    WsPtr =         POINTER TO WsInfo;
        WsInfo =        RECORD
                         handle:  sINTEGER;
                         flags:   sBITSET;
                         addr:    ADDRESS; (* Dummyfeld *)
                         next:    WsPtr;
                         last:    WsPtr;
                        END;

TYPE    TermPtr =       POINTER TO TermInfo;
        TermInfo =      RECORD
                         proc:  PROC;
                         next:  TermPtr;
                        END;


VAR     WorkInArray:    MagicVDI.tWorkIn;
        WorkOutArray:   MagicVDI.tWorkOut;
        applpath:       ARRAY [0..255] OF CHAR;
        applname:       ARRAY [0..20] OF CHAR;

VAR     WorkStation:    WsPtr;
        TermProc:       TermPtr;

VAR     ProgReturn:     sINTEGER;
        stack:          ADDRESS;
        BasePage:       MagicTypes.PtrPD;
        GEMversion:     sINTEGER;
        gdos:           lCARDINAL;
        GrafHandle:     sINTEGER;
        init:           sCARDINAL;

TYPE    tMerker =       RECORD
                         sicht: BOOLEAN;
                         form:  sINTEGER;
                         user:  ADDRESS;
                        END;

VAR     Maus:           ARRAY [0..MaxMaus] OF tMerker;
        Merker:         sCARDINAL;



PROCEDURE ApplInit;
VAR i: sINTEGER;
    b: BOOLEAN;
    l: lCARDINAL;
    f: sINTEGER;
    cw, ch, bw, bh : sINTEGER;
    s: ARRAY [0..3] OF sINTEGER;
    attr: ARRAY [0..9] OF sINTEGER;
    p: WsPtr;
    name: ARRAY [0..7] OF CHAR;
BEGIN
 IF init # 30961 THEN

  (* Applikation anmelden *)
  ApplIdent:= MagicAES.ApplInit ();
  IF ApplIdent < 0 THEN  HALT; END;

  KaosTos:= (MagicAES.AESIntIn[0] = 04B41H) AND (MagicAES.AESIntIn[1] = 04F53H);

  GEMversion:= MagicAES.AESGlobal.apVersion;

  IF GEMversion # ABCGEM THEN  gdos:= MagicSys.VqGdos();
                         ELSE  gdos:= ABCGEM;
  END;

  (* Test auf ApplGetinfo *)
  name := "?AGI"+0c;
  MagicAES.hasAgi := (GEMversion >= $400) OR (MagicAES.ApplFind (ADR(name)) = 0);

  (* Handle der physikalischen Workstation ermitteln *)
  MagicAES.GrafHandle (GrafHandle, CharWidth, CharHeight, BoxWidth, BoxHeight);

  (* Private Workstation ”ffnen *)
  PrivateWS:= OpenWorkstation(Screen, 0, 0, TRUE);
  (* Basiseinstellungen fr PrivateWS vornehmen *)
  MagicVDI.SetTextalignment (PrivateWS, 0, 5, i, i);
  i:= MagicVDI.SetFillcolor (PrivateWS, 0); (* Fllfarbe weiž *)
  b:= MagicVDI.SetFillperimeter (PrivateWS, FALSE); (* Kein Rand *)

  IF (gdos # MagicVDI.NoGdos)
  THEN
    p:= Intern (PrivateWS);
    i := MagicVDI.LoadFonts (PrivateWS, 0);
    INCL (p^.flags, cFonts);
  END;

  (* Den Font des AES ermitteln *)
  MagicAES.WindUpdate (MagicAES.BEGUPDATE);

  b := FALSE;
  IF MagicAES.hasAgi
  THEN
    i := MagicAES.ApplGetinfo (0, AESFontsize, AESFontid, i, i);
    b := i = 1; (* Boolean auf success setzen *)
  END;
  IF ~MagicAES.hasAgi OR ~b
  THEN
    MagicVDI.InqText (GrafHandle, attr); (* Aktuelle Parameter holen *)
    AESFontid := attr[0];


    (* Font setzen und Ergebnis prfen *)
    (*
    IF (MagicVDI.SetTextface (PrivateWS, AESFontid) # AESFontid)
       & (gdos # MagicVDI.NoGdos)
    THEN
      p:= Intern (PrivateWS);
      i := MagicVDI.LoadFonts (PrivateWS, 0);
      INCL (p^.flags, cFonts);
    END;
    *)
    (* Jetzt Font setzen *)
    i := MagicVDI.SetTextface (PrivateWS, AESFontid);

    (* Und jetzt die Gr”že herausknobeln *)
    f:= 0;
    REPEAT
     INC (f);
     MagicVDI.SetCharheight (PrivateWS, f, cw, ch, bw, bh);
    UNTIL (bw = CharWidth) AND (bh = CharHeight); (* !!! *)

    AESFontsize:= f;


  END;

  MagicAES.WindUpdate (MagicAES.ENDUPDATE);

  (* Jetzt Font setzen *)
  i := MagicVDI.SetTextface (PrivateWS, AESFontid);
  MagicVDI.SetCharheight (PrivateWS, AESFontsize, i,i,i,i);

  (* Allgemeine Workstation ”ffnen *)
  VDIHandle:= OpenWorkstation(Screen, 0, 0, TRUE);

  (* Gesamtbreite und H”he des Bildschirms *)
  MaxWidth:= WorkOutArray[0] + 1;
  MaxHeight:= WorkOutArray[1] + 1;
  MaxColors:= WorkOutArray[13];

  MagicAES.WindGet (0, 7, s);  DeskX:= s[0];  DeskY:= s[1];

  (* Bitplanes:= MagicAES.AESGlobal.apNplanes; *)
  MagicVDI.ExtendedInq (VDIHandle, MagicVDI.Extended, WorkOutArray);
  Bitplanes:= WorkOutArray[4];

  (* MausStack initialisieren *)
  Merker:= 0;
  Maus[Merker].sicht:= TRUE;
  Maus[Merker].form:= MagicAES.ARROW;
  Maus[Merker].user:= Null;
  MagicAES.GrafMouse (MagicAES.ARROW, Null);

 END;
END ApplInit;

PROCEDURE InstallTermproc (proc: PROC);
VAR p: TermPtr;

 PROCEDURE new (): TermPtr;
 VAR q: TermPtr;
 BEGIN
  ALLOCATE (q, TSIZE(TermInfo));
  IF q = NIL THEN  HALT;  END;
  q^.proc:= proc;
  q^.next:= NIL;
  RETURN q;
 END new;

BEGIN
 (*
 IF TermProc = NIL THEN
  TermProc:= new ();
 ELSE
 *)
  p:= TermProc;
  TermProc := new ();
  TermProc^.next := p;
  (*
  WHILE p^.next # NIL DO  p:= p^.next;  END;
  p^.next:= new ();
 END;
  *)
END InstallTermproc;

PROCEDURE ApplDeinstall;
  VAR p: TermPtr;
BEGIN
  (* Installierte TermProcedures abarbeiten *)
  p:= TermProc;
  WHILE (p # NIL) DO  p^.proc;  p:= p^.next;  END;
END ApplDeinstall;

PROCEDURE ApplTerm (return: sINTEGER);
VAR  p: TermPtr;
     q: WsPtr;
     i: sINTEGER;
BEGIN
 (* Installierte TermProcedures abarbeiten *)
 p:= TermProc;
 WHILE (p # NIL) DO  p^.proc;  p:= p^.next;  END;
 q:= WorkStation;
 WHILE (q # NIL) DO
  IF cFonts IN q^.flags THEN  MagicVDI.UnloadFonts (q^.handle, 0);  END;
  IF cPhysical IN q^.flags THEN MagicVDI.CloseWorkstation (q^.handle);
                           ELSE MagicVDI.CloseVirtual (q^.handle);
  END;
  q:= q^.next;
 END; (* WHILE *)
 MouseOn;
 MagicAES.ApplExit;
 (* MagicSys.Terminate (return); *)
END ApplTerm;

PROCEDURE ApplPath (VAR pfad: ARRAY OF CHAR);
BEGIN
 Assign (applpath, pfad);
END ApplPath;

PROCEDURE ApplName (VAR name: ARRAY OF CHAR);
BEGIN
 Assign (applname, name);
END ApplName;

PROCEDURE OpenWS (kind, x, y, rc: sINTEGER): sINTEGER;
VAR array: POINTER TO ARRAY [0..255] OF sINTEGER;
    h, i: sINTEGER;
    flag: sBITSET;
    p:    WsPtr;

 PROCEDURE new (handle: sINTEGER; flags: BITSET): WsPtr;
 VAR q: WsPtr;  i: INTEGER;
 BEGIN
  ALLOCATE (q, TSIZE (WsInfo));
  IF q = NIL THEN  HALT;  END;
  q^.handle:= handle;  q^.flags:= flags;  q^.addr:= NIL;
  q^.next:= NIL;  q^.last:= NIL;
  RETURN q;
 END new;

BEGIN
 WorkInArray[ 1]:= 1;    (* Linientyp, durchgehender Strich *)
 WorkInArray[ 2]:= 1;    (* Liniefarbe, schwarz             *)
 WorkInArray[ 3]:= 1;    (* Markertyp, Punkt                *)
 WorkInArray[ 4]:= 1;    (* Markerfarbe, schwarz            *)
 WorkInArray[ 5]:= AESFontid;    (* Textfont, Systemzeichensatz     *)
 WorkInArray[ 6]:= 1;    (* Textfarbe, schwarz              *)
 WorkInArray[ 7]:= 1;    (* Flltyp, voll                   *)
 WorkInArray[ 8]:= 1;    (* Musterindex,                    *)
 WorkInArray[ 9]:= 1;    (* Musterfarbe, schwarz            *)
 WorkInArray[10]:= rc;   (* Koordinatensystem               *)
 IF kind < 11 THEN
  (* Virtuelle Workstation ”ffnen *)
  WorkInArray[ 0]:= 1; (* Art der Workstation *)
  h:= GrafHandle;
  MagicVDI.OpenVirtual (WorkInArray, h, WorkOutArray);
  IF h < 0 THEN  RETURN -1;  END;
  flag:= {};
 ELSE
  (* Physikalische Workstation ”ffnen *)
  WorkInArray[ 0]:= kind; (* Art der Workstation *)
  IF (kind < 31) AND ((x # 0) OR (y # 0)) THEN
   MagicVDI.VDIPtsIn[0]:= x;
   MagicVDI.VDIPtsIn[1]:= y;
  END;
  MagicVDI.OpenWorkstation (WorkInArray, h, WorkOutArray);
  IF h <= 0 THEN  RETURN -1;  END;
  flag:= {cPhysical};
 END;
 IF WorkStation = NIL THEN
  WorkStation:= new (h, flag);
 ELSE
  p:= WorkStation;
  WHILE p^.next # NIL DO  p:= p^.next;  END;
  p^.next:= new (h, flag);  p^.next^.last:= p;
 END;
 RETURN h;
END OpenWS;

PROCEDURE OpenWorkstation (device: Device; w, h: sINTEGER; rc: BOOLEAN): sINTEGER;
VAR try, max, ws, coord: sINTEGER;
BEGIN
 IF rc THEN  coord:= RC;  ELSE  coord:= NDC;  END;
 CASE device OF
  Screen:   try:= 1;   max:= 1; (* Mehr als aktuelle Aufl”sung is nicht *)|
  Plotter:  try:= 11;  max:= 20;|
  Printer:  try:= 21;  max:= 30;|
  Metafile: try:= 31;  max:= 40;|
  Camera:   try:= 41;  max:= 50;|
  Tablett:  try:= 51;  max:= 60;|
  ELSE      ;
 END;
 LOOP
  IF try > max THEN  RETURN -1;  END;
  ws:= OpenWS (try, w, h, coord);
  IF ws > 0 THEN  RETURN ws;  END;
  INC (try);
 END;
END OpenWorkstation;

PROCEDURE Intern (handle: sINTEGER): ADDRESS;
VAR p: WsPtr;
BEGIN
 IF handle = -1 THEN  RETURN WorkStation;  END;
 p:= WorkStation;
 WHILE p # NIL DO
  IF p^.handle = handle THEN  RETURN p;  END;
  p:= p^.next;
 END;
 RETURN NIL;
END Intern;

PROCEDURE CloseWorkstation (handle: sINTEGER);
VAR p: WsPtr;
BEGIN
 p:= Intern (handle);
 IF p # NIL THEN
  IF cFonts IN p^.flags THEN  MagicVDI.UnloadFonts (p^.handle, 0);  END;
  IF cPhysical IN p^.flags THEN MagicVDI.CloseWorkstation (p^.handle);
                           ELSE MagicVDI.CloseVirtual (p^.handle);
  END;
  IF p^.last # NIL
  THEN
    p^.last^.next:= p^.next;
  END;
  IF p^.next # NIL
  THEN
    p^.next^.last := p^.last;
  END;
  DEALLOCATE (p, 0);
 END; (* IF *)
END CloseWorkstation;

(*----------------------------------------------------------------------*
 *                            M„usetreiberei                            *
 *----------------------------------------------------------------------*)

PROCEDURE MausEin (mausform: sINTEGER);
BEGIN
 WITH Maus[Merker] DO
  IF NOT sicht THEN
   sicht:= TRUE;  MagicAES.GrafMouse (MagicAES.MON, Null);
  END;
  IF form # mausform THEN
   form:= mausform;
   IF form = MagicAES.USERDEF THEN MagicAES.GrafMouse (form, user);
                              ELSE MagicAES.GrafMouse (form, Null);
   END;
  END;
 END;
END MausEin;

PROCEDURE MouseOn;
BEGIN
 MausEin (Maus[Merker].form);
END MouseOn;

PROCEDURE MouseArrow;
BEGIN
 MausEin (MagicAES.ARROW);
END MouseArrow;

PROCEDURE MouseCursor;
BEGIN
 MausEin (MagicAES.TEXTCRSR);
END MouseCursor;

PROCEDURE MouseBusy;
BEGIN
 MausEin (MagicAES.BUSYBEE);
END MouseBusy;

PROCEDURE MouseFinger;
BEGIN
 MausEin (MagicAES.POINTHAND);
END MouseFinger;

PROCEDURE MouseHand;
BEGIN
 MausEin (MagicAES.FLATHAND);
END MouseHand;

PROCEDURE MouseThincross;
BEGIN
 MausEin (MagicAES.THINCROSS);
END MouseThincross;

PROCEDURE MouseThickcross;
BEGIN
 MausEin (MagicAES.THICKCROSS);
END MouseThickcross;

PROCEDURE MouseOutline;
BEGIN
 MausEin (MagicAES.OUTLCROSS);
END MouseOutline;

PROCEDURE MouseUser;
BEGIN
 Maus[Merker].form:= -1;  MausEin (MagicAES.USERDEF);
END MouseUser;

PROCEDURE MouseOff;
BEGIN
 WITH Maus[Merker] DO
  IF sicht THEN
   sicht:= FALSE;  MagicAES.GrafMouse (MagicAES.MOFF, Null);
  END;
 END;
END MouseOff;

PROCEDURE MouseState (VAR form: sINTEGER; VAR sichtbar: BOOLEAN);
BEGIN
 form:= Maus[Merker].form;
 sichtbar:= Maus[Merker].sicht;
END MouseState;

PROCEDURE StoreMouse;
BEGIN
 IF Merker < MaxMaus THEN
  INC (Merker);
  Maus[Merker].sicht:= Maus[Merker-1].sicht;
  Maus[Merker].form:=  Maus[Merker-1].form;
  Maus[Merker].user:=  Maus[Merker-1].user;
 END;
END StoreMouse;

PROCEDURE RestoreMouse;
VAR view: BOOLEAN;
BEGIN
 IF Merker > 0 THEN
  view:= Maus[Merker].sicht;
  DEC (Merker);
  WITH Maus[Merker] DO
   IF view AND NOT sicht THEN
    MagicAES.GrafMouse (MagicAES.MOFF, Null);
   ELSIF NOT view AND sicht THEN
    MagicAES.GrafMouse (MagicAES.MON, Null);
   END;
   IF form = MagicAES.USERDEF THEN  MagicAES.GrafMouse (form, user);
                              ELSE  MagicAES.GrafMouse (form, Null);
   END;
  END;
 END;
END RestoreMouse;

PROCEDURE UserMouse (VAR form: ARRAY OF LOC);
BEGIN
 Maus[Merker].user:= ADR (form);
END UserMouse;

PROCEDURE SetMouse (x, y: sCARDINAL);
VAR xx, yy: sINTEGER;
    ch:     CHAR;
    s:      sBITSET;
BEGIN
 MouseOff;
 s:= MagicVDI.InputLocatorSM (PrivateWS, x, y, xx, yy, ch);
 MouseOn;
END SetMouse;

PROCEDURE VqGdos (): lCARDINAL;
BEGIN
 RETURN gdos;
END VqGdos;

PROCEDURE InitMtAppl;
VAR p: ARRAY [0..255] OF CHAR;
    (*$Reg*)  c, d: sCARDINAL;
BEGIN
 IF init # 30961 THEN


  WorkStation:= NIL;  TermProc:= NIL;
  ApplInit;  (* Applikation und Workstations initialisieren *)

  MagicAES.ShelRead (applpath, p);
  c:= Length (applpath);
  WHILE (c > 0) & (applpath [c - 1] # '\') DO
   DEC (c);
  END; (* WHILE *)
  IF c = 0
  THEN
    (* Kein Pfad drin, nur Name der Applikation! *)
    Assign (applpath, applname);
    (* Applikation mittels shel_find suchen *)
    MagicAES.ShelFind (applpath);
    (* So, und jetzt noch nach letztem Slash suchen und da abschneiden *)
    c:= Length (applpath);
    WHILE (c > 0) & (applpath [c - 1] # '\') DO
       DEC (c); applpath[c] := 0c;
     END; (* WHILE *)
  ELSE
    (* Ist ein Pfad drin, jetzt trennen *)
    FOR d := c TO Length (applpath) DO
      applname [d-c] := applpath[d];
    END;
    applpath[c] := 0c;
  END;

  IF Length (applpath) = 0
  THEN
    MagicDOS.Dgetpath (applpath, MagicDOS.Dgetdrv()+1);
    IF applpath[1] # ':'
    THEN
      d := MagicDOS.Dgetdrv();
      IF applpath[0] # '\'
      THEN
        Insert ('A:\', applpath, 0);
      ELSE
        Insert ('A:', applpath, 0);
      END;
      applpath[0] := CHR(ORD('A') + d);
    END;
  END;

  c := Length (applpath);
  IF (c > 0 ) & (applpath[c-1] # '\') THEN
    applpath[c] := '\';
    applpath[c+1] := 0c;
  END;

  init:= 30961;
 END;
END InitMtAppl;



BEGIN
 init:= 0;
 InitMtAppl;
END mtAppl.